home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / netz / archie / doc / archie.el < prev    next >
Lisp/Scheme  |  1995-08-16  |  24KB  |  633 lines
  1. ;; Questions about this version to Jack Repenning <jackr@sgi.com>
  2. ;;
  3. ;; archie.el v2.0
  4. ;;   A mock-interface to Archie for Emacs.
  5. ;;
  6. ;;   -- original version by Brendan Kehoe (brendan@cs.widener.edu)
  7. ;;   ange-ftp extensions by Sanjay Mathur (mathur@nas.nasa.gov)
  8. ;;   ----- async support by Andy Norman (ange@hplb.hpl.hp.com)
  9. ;;   ----- convert-to-dired by (drw@bourbaki.mit.edu)
  10. ;;   ----- archie-server-preference-list by Jack Repenning (jackr@sgi.com)
  11. ;;   ----- merge with original archie mode by Piet van Oostrum <piet@cs.ruu.nl>
  12. ;;   ----- many enhancements thanks to the ange-ftp-lovers list
  13. ;;   ----- further archie-mode functions, cleanup, by Rob Austein
  14. ;;         ClearCase: archie.el@@/main/37
  15. ;;         sites:     /ftp@sgigate.sgi.com:/pub/archie-aux/archie.el
  16. ;;                    /ftp@alpha.gnu.ai.mit.edu:ange-ftp/archie.el
  17. ;; 
  18. ;; This file is not part of GNU Emacs but the same permissions apply.
  19. ;; 
  20. ;; GNU Emacs is free software; you can redistribute it and/or modify
  21. ;; it under the terms of the GNU General Public License as published by
  22. ;; the Free Software Foundation; either version 1, or (at your option)
  23. ;; any later version.
  24. ;;
  25. ;; GNU Emacs is distributed in the hope that it will be useful,
  26. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  27. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  28. ;; GNU General Public License for more details.
  29. ;;
  30. ;; You should have received a copy of the GNU General Public License
  31. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  32. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  33. ;;
  34. ;;
  35.  
  36. ;; Usage:
  37. ;;
  38. ;; M-x archie creates a separate buffer from which you can find, copy
  39. ;; or run dired on any of the entries (using ange-ftp) and redo the search
  40. ;; with modified string and/or search-type.
  41. ;; alternatively M-x archie creates a separate buffer in dired mode (q.v).
  42.  
  43. ;;
  44.  
  45. ;; Installation instructions:
  46. ;;
  47. ;; Install this file as archie.el somewhere in your load-path and add the
  48. ;; following two lines to ~/.emacs. (without the semicolon's, of course)
  49. ;;
  50. ;; (autoload 'archie "archie" "Archie interface" t)
  51. ;;
  52. ;; You may have to change the value of archie-program and archie-server
  53. ;; as appropriate for your site.
  54. ;; archie-search-type and archie-download-directory can be modified
  55. ;; to suit personal preferences.
  56. ;;
  57. ;; For use with this package, it is also convenient to set
  58. ;;  (setq ange-ftp-generate-anonymous-password t)
  59. ;;
  60. ;;  Also, the crypt package (available in the LCD archives) is useful
  61. ;;  with archie-find-file, since most archive sites store their files
  62. ;;  in a compressed form.
  63.  
  64. ;;
  65. ;; LCD Archive Entry:
  66. ;; archie|Sanjay R. Mathur|mathur@nas.nasa.gov
  67. ;; |A mock-interface to the archie program.
  68. ;; Wed Apr 22 22:31:46 1992|2.0||
  69. ;;
  70.  
  71. ;; Customization variables
  72.  
  73. (defvar archie-program "archie"
  74.   "Program that queries archie servers.")
  75.  
  76. (defvar archie-server-list
  77.   '(("archie.funet.fi"      .  "128.214.6.100   (European server in Finland)")
  78.     ("archie.rutgers.edu"   .  "128.6.18.15     (Rutgers University)")
  79.     ("archie.sura.net"      .  "128.167.254.179 (SuraNet (Maryland, USA))")
  80.     ("archie.unl.edu"       .  "129.93.1.14     (University of Nebraska in Lincoln)")
  81.     ("archie.cs.huji.ac.il" .  "132.65.6.15     (Israel server)")
  82.     ("archie.au"            .  "139.130.4.6     (Australian server)")
  83.     ("archie.doc.ic.ac.uk"  .  "146.169.11.3    (UK/England server)")
  84.     ("archie.ans.net"       .  "147.225.1.2     (ANS archie server)")
  85.     ("archie.ncu.edu.tw"    .  "140.115.19.24   (Taiwanese server)")
  86.     ("archie.wide.ad.jp"    .  "133.4.3.6       (Japanese server)"))
  87.   "List of known archie servers.")
  88.  
  89. (defvar archie-server nil
  90.    "*Server for \\[archie] searches.  If ``nil'' (the default), asks.
  91. Known archie servers are listed in archie-server-list.")
  92.  
  93. (defvar archie-download-directory nil
  94.   "*Default directory into which any files copied by archie-copy are
  95. copied. nil means to use /usr/tmp.")
  96.  
  97. (defvar archie-search-type "exact"
  98.   "*Search type for \\[archie] searches.  (Used to set command-line
  99. argument for archie program.)  See also archie-search-type-sticky.
  100.  
  101. Can be one of:
  102.         exact                   for exact matches (-e) (default)
  103.         regexp                  for a regexp (-r)
  104.         substring               for substring searches (-c) 
  105.         case-insensitive        for a case-insensitive substring search (-s)
  106.         exact-regexp            for an exact regexp (-er)
  107.         exact-substring         for an exact substring search (-es)
  108.         exact-case-insensitive  for exact case-insensitive search (-ec)
  109.         nil                     to ask every time")
  110.  
  111. (defvar archie-search-type-sticky t
  112.   "*Once you specify a search type, should it be made the new default
  113. (new value of archie-search-type)?")
  114.  
  115. (defvar archie-search-type-alist
  116.   ;; This is left as a defvar instead of defconst in case you don't like
  117.   ;; the keyword choice here, eg, you want "substring" to mean
  118.   ;; "case-insensitive-substring" (-s) as Allah clearly intended.
  119.   '(("substring" . "-c")
  120.     ("exact" . "-e")
  121.     ("regexp" . "-r")
  122.     ("case-insensitive" . "-s")
  123.     ("exact-substring" . "-ec")
  124.     ("exact-case-insensitive" . "-es")
  125.     ("exact-regexp" . "-er"))
  126.   "*Alist of search types for \\[archie] searches.")
  127.  
  128. (defvar archie-internal-search-type-alist nil
  129.   "Internal version of archie-search-type-alist (includes switches, as
  130. well as keywords).")
  131.  
  132. (defun archie-search-type-alist ()
  133.   "Returns value of archie-internal-search-type-alist, updating it if
  134. necessary."
  135.   (if (eq archie-search-type-alist
  136.           (nthcdr (length archie-search-type-alist)
  137.                   archie-internal-search-type-alist))
  138.       archie-internal-search-type-alist
  139.     (setq archie-internal-search-type-alist
  140.           (nconc (mapcar (function (lambda (x) (cons (cdr x) (cdr x))))
  141.                          archie-search-type-alist)
  142.                  archie-search-type-alist))))
  143.  
  144. (defvar archie-do-convert-to-dired nil
  145.   "*If t archie buffers are converted to dired-mode, otherwise archie-mode
  146. is used.")
  147.  
  148. (defvar archie-search-hits "1000"
  149.   "*Maximum number of hits to ask for in search.")
  150.  
  151. (defvar archie-window-management 'at-end
  152.   "*When should \\[archie] display the window with the answer?
  153.         'at-start       When the search is initiated
  154.         'at-end         When the result is ready
  155.         'both           Both
  156.         otherwise       Never")
  157.  
  158. (defvar archie-server-preference-list nil
  159.   "*List of regexps for ordering archie results by server.  May be
  160. right-anchored with \"$\", e.g.:
  161.         '(\"erlangen\\.de$\"
  162.           \"tu-muenchen\\.de$\"
  163.           \"\\.de$\")")
  164.  
  165. (defvar archie-dired-unusable-functions
  166.   (list
  167.    ;; Classic dired functions
  168.    'dired-backup-unflag
  169.    'dired-byte-recompile
  170.    'dired-chgrp
  171.    'dired-chmod
  172.    'dired-chown
  173.    'dired-clean-directory
  174.    'dired-compress
  175.    'dired-do-deletions
  176.    'dired-flag-auto-save-files
  177.    'dired-flag-backup-files
  178.    'dired-flag-file-deleted
  179.    'dired-rename-file
  180.    'dired-uncompress
  181.  
  182.    ;;; Tree-dired functions
  183.    'dired-backup-diff
  184.    ;; 'dired-backup-unflag
  185.    'dired-clean-directory
  186.    ;; 'dired-create-directory
  187.    ;; 'dired-diff
  188.    'dired-do-byte-compile
  189.    'dired-do-chgrp
  190.    ;; 'dired-do-chmod
  191.    'dired-do-chown
  192.    'dired-do-compress
  193.    ;; 'dired-do-copy
  194.    ;; 'dired-do-copy-regexp
  195.    'dired-do-delete
  196.    'dired-do-flagged-delete
  197.    'dired-do-hardlink
  198.    'dired-do-hardlink-regexp
  199.    ;; 'dired-do-kill
  200.    'dired-do-load
  201.    ;; 'dired-do-move ; amounts to dired-do-copy
  202.    'dired-do-print
  203.    ;; 'dired-do-redisplay
  204.    'dired-do-rename-regexp
  205.    ;; 'dired-do-shell-command   ; not likely the command knows what to
  206.                                 ; do with such a name, but what the hey
  207.    'dired-do-symlink
  208.    'dired-do-symlink-regexp
  209.    'dired-do-uncompress
  210.    'dired-downcase
  211.    ;; 'dired-find-file
  212.    ;; 'dired-find-file-other-window
  213.    'dired-flag-auto-save-files
  214.    'dired-flag-backup-files
  215.    'dired-flag-file-deleted
  216.    'dired-flag-regexp-files
  217.    'dired-hide-all              ; when ``i'' works ...
  218.    'dired-hide-subdir           ; when ``i'' works ...
  219.    ;; 'dired-kill-line-or-subdir
  220.    ;; 'dired-mark-directories
  221.    ;; 'dired-mark-executables
  222.    ;; 'dired-mark-files-regexp
  223.    ;; 'dired-mark-subdir-or-file
  224.    ;; 'dired-mark-symlinks
  225.    'dired-maybe-insert-subdir
  226.    ;; 'dired-next-dirline
  227.    ;; 'dired-next-line
  228.    ;; 'dired-next-marked-file
  229.    ;; 'dired-next-subdir
  230.    ;; 'dired-prev-dirline
  231.    ;; 'dired-prev-marked-file
  232.    ;; 'dired-prev-subdir
  233.    ;; 'dired-previous-line
  234.    ;; 'dired-quit
  235.    'dired-sort-toggle-or-edit
  236.    ;; 'dired-summary
  237.    ;; 'dired-tree-down
  238.    ;; 'dired-tree-up
  239.    ;; 'dired-undo
  240.    ;; 'dired-unflag-all-files
  241.    ;; 'dired-unmark-subdir-or-file
  242.    ;; 'dired-up-directory
  243.    'dired-upcase
  244.    ;; 'dired-view-file
  245.    ;; 'dired-why
  246.    ;; 'revert-buffer            ; replaced with archie-modify-query
  247.    )
  248.   "*List of dired functions that should be removed from the
  249. archie-dired-mode keymap.")
  250.  
  251. (defvar archie-mode-hook nil
  252.   "Hooks to run after entering archie (non-dired) mode.")
  253.  
  254. (defvar archie-dired-mode-hook nil
  255.   "Hooks to run after entering archie-dired-mode.")
  256.  
  257. (defvar archie-anonymous-ftp-username "anonymous"
  258.   "Username to use for \"anonymous\" FTP connections.
  259. Set to \"anonymous\" by default, since more sites accept that than any
  260. other username (even \"ftp\", and no, not all machines in the world
  261. think they're synonyms).  For dired-mode archie, this only matters for
  262. hosts where you've got a non-anonymous username set.")
  263.  
  264. (defvar archie-display-hook nil
  265.   "Hook run after displaying the results buffer.")
  266.  
  267. (defvar archie-load-hook nil
  268.   "Hooks run after loading archie.el")
  269.  
  270.  
  271. ;; Variables you shouldn't have to customize
  272.  
  273. (defvar archie-l-output "[0-9]*Z *[0-9]* *\\([^ ]*\\) *\\(.*$\\)"
  274.   "Regular expression matching the results of archie -l query. The
  275.    two subexpressions match the host-name and the path respectively.")
  276.  
  277. (defvar archie-last-query nil)
  278. (defvar archie-last-type nil)
  279.  
  280. (defvar archie-mode-map
  281.   (let ((map (make-sparse-keymap)))
  282.     (define-key map "f" 'archie-find-file)
  283.     (define-key map "a" 'archie-modify-query)
  284.     (define-key map "c" 'archie-copy)
  285.     (define-key map "x" 'convert-archie-to-dired)
  286.     (define-key map "d" 'archie-dired)
  287.     (define-key map "v" 'archie-view-file)
  288.     (define-key map "n" 'archie-next-line)
  289.     (define-key map "s" 'archie-change-server)
  290.     (define-key map " " 'archie-next-line)
  291.     (define-key map "\C-n" 'archie-next-line)
  292.     (define-key map "p" 'archie-previous-line)
  293.     (define-key map "\C-?" 'archie-previous-line)
  294.     (define-key map "\C-p" 'archie-previous-line)
  295.     map)
  296.   "Local keymap used when in archie (non-dired) mode.")
  297.  
  298. (defvar archie-dired-mode-map nil
  299.   "Local keymap used when in archie-dired-mode.  Normally cloned from
  300. dired-mode-map, after dired-mode-hook is run.")
  301.  
  302. (defun archie (type string)
  303.   "Search (with style TYPE, or prompt if arg) for STRING on an Archie
  304. server.
  305.  
  306. TYPE is the type of search to make -- by default, it's
  307. `archie-search-type'.  Possible values are exact, substring (case
  308. sensitive), case-insensitive and regexp (a regular expression).
  309. Interactively, a prefix arg will make it prompt for this. If
  310. archie-search-type is NIL, always prompts.  If
  311. archie-search-type-sticky is non-nil, each specified value is used as
  312. the next default; otherwise it reverts to archie-search-type.
  313.  
  314. STRING is the string (or regexp) for which to search.
  315.  
  316. If archie-do-convert-to-dired is non-NIL, the buffer is converted to a
  317. dired buffer.
  318.  
  319. The total number of search hits will be limited to (approximately)
  320. archie-search-hits.  If the prefix arg is >= 16 (e.g., ^U ^U
  321. \\[archie]), then you will be prompted for a new value for
  322. archie-search-hits."
  323.   (interactive (archie-get-query-args archie-search-type nil))
  324.   (let ((buf (generate-new-buffer string))
  325.         (flags (concat (or (cdr (assoc type (archie-search-type-alist)))
  326.                            (cdr (assoc archie-search-type
  327.                                        (archie-search-type-alist)))
  328.                            "-e"))))
  329.     (save-window-excursion
  330.       (set-buffer buf)
  331.       (setq archie-last-query string)
  332.       (setq archie-last-type type)
  333.       (setq buffer-read-only nil)
  334.       (erase-buffer)
  335.       (archie-mode)
  336.       (set
  337.        (make-local-variable 'archie-msg)
  338.        (message "Asking archie for %s match for \"%s\" ..." type string)))
  339.     (if (or (eq archie-window-management 'at-start)
  340.             (eq archie-window-management 'both))
  341.         (progn
  342.           (display-buffer buf)
  343.           (run-hooks 'archie-display-hook)))
  344.     (let ((proc (start-process "archie" ;name
  345.                                buf      ;buffer
  346.                                archie-program ;program
  347.                                "-h" archie-server ;program args
  348.                                "-m" archie-search-hits
  349.                                flags "-l" "-"
  350.                                string)))
  351.       (process-kill-without-query proc)
  352.       (set-process-sentinel proc (function archie-process-sentinel)))))
  353.  
  354. (defun archie-process-sentinel (proc string)
  355.   (if (buffer-name (process-buffer proc))
  356.       (unwind-protect
  357.           (save-window-excursion
  358.             (set-buffer (process-buffer proc))
  359.             (let ((am archie-msg))
  360.               (message "%s converting." am)
  361.               (goto-char (point-min))
  362.               (archie-order-results)
  363.               (require 'ange-ftp)
  364.               (if archie-do-convert-to-dired (convert-archie-to-dired))
  365.               (setq buffer-read-only t)
  366.               (message "%s done." am)))
  367.         (if (or (eq archie-window-management 'at-end)
  368.                 (eq archie-window-management 'both))
  369.             (progn
  370.               (display-buffer (process-buffer proc))
  371.               (run-hooks 'archie-display-hook))))))
  372.  
  373. (defun archie-order-results ()
  374.   "Order archie results by archie-server-preference-list."
  375.   (goto-char (point-min))
  376.   (mapcar
  377.    (function
  378.     (lambda (server-re)
  379.       (let (match)
  380.         (if (string-match "\\$$" server-re)
  381.             (setq server-re
  382.                   (concat (substring server-re 0 -1) " ")))
  383.         (while
  384.             (save-excursion
  385.               (re-search-forward (concat "^[0-9Z]+\\s +[0-9]+ \\S *"
  386.                                          server-re
  387.                                          ".*")
  388.                                  nil t))
  389.           (setq match (buffer-substring (match-beginning 0) (1+ (match-end 0))))
  390.           (delete-region  (match-beginning 0) (1+ (match-end 0)))
  391.           (insert match)))))
  392.    archie-server-preference-list))
  393.  
  394. (defun convert-archie-to-dired ()
  395.   "Convert a buffer containing output in 'archie -l' format into a Dired-mode
  396. buffer in which the usual Dired commands can be used, via ange-ftp."
  397.   (interactive)
  398.   (if (not (fboundp 'ange-ftp-get-user)) (load "ange-ftp"))
  399.   (let (lines b s date size host file type year)
  400.     (setq year (substring (current-time-string) -4))
  401.     (setq lines (count-lines (point-min) (point-max)))
  402.     (setq buffer-read-only nil)
  403.     (goto-char (point-min))
  404.     (insert "  total " (int-to-string lines) ?\n)
  405.     (while (not (eobp))
  406.       (condition-case error
  407.           (progn
  408.             (setq b (point))
  409.             (beginning-of-line 2)
  410.             (setq s (buffer-substring b (point)))
  411.             (or (string-match
  412.                  "^\\([0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]\\)Z +\\([0-9]+\\) \\([-_.a-zA-Z0-9]+\\) \\([^ \n]+\\)$"
  413.                  s)
  414.                 (error "Line not from 'archie -l'"))
  415.             (setq date (substring s (match-beginning 1) (match-end 1)))
  416.             (setq size (substring s (match-beginning 2) (match-end 2)))
  417.             (setq host (substring s (match-beginning 3) (match-end 3)))
  418.             (setq file (substring s (match-beginning 4) (match-end 4)))
  419.             (if (string-equal (substring file -1) "/")
  420.                 (setq file (substring file 0 -1)
  421.                       type "d")
  422.               (setq type "-"))
  423.             (save-excursion
  424.               (insert "  "
  425.                       ;; - or d, depending on whether it's a file or a directory
  426.                       type
  427.                       "r--r--r--  1 ftp"
  428.                       ;; file size
  429.                       (make-string (- 8 (length size)) ? )
  430.                       size
  431.                       " "
  432.                       ;; creation date
  433.                       (condition-case error
  434.                           (aref
  435.                            ["Jan" "Feb" "Mar" "Apr" "May" "Jun"
  436.                             "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"]
  437.                            (1- (string-to-int (substring date 4 6))))
  438.                         (error "Jan"))
  439.                       " "
  440.                       (if (= (aref date 6) ?0)
  441.                           (concat " " (substring date 7 8))
  442.                         (substring date 6 8))
  443.                       (if (string-equal (substring date 0 4) year)
  444.                           (concat " " (substring date 8 10) ":" (substring date 10 12))
  445.                         (concat "  " (substring date 0 4)))
  446.                       ;; file name, in Ange-FTP format
  447.                       (archie-get-user-prefix host) host ":" file
  448.                       ?\n))
  449.             (delete-region b (point))
  450.             (forward-line 1))
  451.         (error (forward-line 1))))
  452.     (archie-dired-mode)
  453.     (goto-char (point-min))
  454.     ;; Set subdir-alist so that Tree Dired will work:
  455.     (if (fboundp 'dired-simple-subdir-alist)
  456.         ;; will work even with nested dired format (dired-nstd.el,v 1.15
  457.         ;; and later)
  458.         (dired-simple-subdir-alist)
  459.       ;; else we have an ancient tree dired (or classic dired, where
  460.       ;; this does no harm) 
  461.       (set (make-local-variable 'dired-subdir-alist)
  462.            (list (cons default-directory (point-min-marker)))))))
  463.  
  464. (defun archie-get-user-prefix (host)
  465.   "Return a suitable string to affix to the archie filename for this HOST."
  466.   (if (not (fboundp 'ange-ftp-get-user)) (load "ange-ftp"))
  467.   (let ((prefix (concat " /" archie-anonymous-ftp-username "@")))
  468.     (if (or (not ange-ftp-default-user)
  469.             (stringp ange-ftp-default-user))
  470.         (let ((user (ange-ftp-get-user host)))
  471.           (if (or (string-equal user "anonymous")
  472.                   (string-equal user "ftp"))
  473.               (setq prefix " /"))))
  474.     prefix))
  475.  
  476. (defun archie-dired-mode ()
  477.   "Mode for handling archie output as a dired buffer.  Uses your own
  478. dired mode, as customized by any hooks.  Also runs your own
  479. archie-dired-mode-hook, if any, and uses this modified keymap:
  480. \\{archie-dired-mode-map}."
  481.   (if (not (fboundp 'dired-mode)) (load "dired"))
  482.   (dired-mode (concat "archie " (buffer-name)))
  483.   (setq default-directory "/usr/tmp/")
  484.   (if archie-dired-mode-map
  485.       nil
  486.     (setq archie-dired-mode-map
  487.           (copy-keymap (current-local-map)))
  488.     (mapcar
  489.      (function (lambda (fn)
  490.                  (substitute-key-definition fn nil archie-dired-mode-map)))
  491.      archie-dired-unusable-functions)
  492.     (substitute-key-definition 'revert-buffer
  493.                                'archie-modify-query archie-dired-mode-map)
  494.     (define-key archie-dired-mode-map "s" 'archie-change-server))
  495.   (use-local-map archie-dired-mode-map)
  496.   (setq major-mode 'archie-dired-mode)
  497.   (setq mode-name "Archie Dired")
  498.   (setq mode-line-buffer-indication '("Archie Dired: %17b"))
  499.   (run-hooks 'archie-dired-mode-hook))
  500.  
  501. (defun archie-get-filename ()
  502.     (beginning-of-line)
  503.     (if (looking-at archie-l-output)
  504.         (concat "/" archie-anonymous-ftp-username "@"
  505.                 (buffer-substring (match-beginning 1) (match-end 1))
  506.                 ":"
  507.                 (buffer-substring (match-beginning 2) (match-end 2)))
  508.       (error "Not archie -l output")))
  509.  
  510. (defun archie-next-line (arg)
  511.   (interactive "p")
  512.   (next-line arg)
  513.   (if (looking-at archie-l-output)
  514.       (goto-char (match-beginning 1))))
  515.  
  516. (defun archie-previous-line (arg)
  517.   (interactive "p")
  518.   (previous-line arg)
  519.   (if (looking-at archie-l-output)
  520.       (goto-char (match-beginning 1))))
  521.  
  522. (defun archie-find-file ()
  523.   "Find the file mentioned on the current line of archie -l output.
  524. Runs dired if the file is a directory and find-file-run-dired is
  525. non-nil."
  526.   (interactive)
  527.   (find-file (archie-get-filename)))
  528.  
  529. (defun archie-view-file ()
  530.   "View the file mentioned on the current line of archie -l output."
  531.   (interactive)
  532.   (view-file (archie-get-filename)))
  533.  
  534. (defun archie-copy ()
  535.   "Copy the file mentioned on the current line of archie -l output.
  536.    Prompts with the value implied by archie-download-directory
  537.    as the default directory in which to copy. The file-name part can be
  538.    empty, in which case the original name is used."
  539.   (interactive)
  540.   (let* ((from (archie-get-filename))
  541.          (from-nondir (file-name-nondirectory from))
  542.          (to nil))
  543.     (if (string-equal "" from-nondir)
  544.         (error "%s is a directory" from))
  545.     (setq to (read-file-name
  546.               (format "Copy %s to: " from-nondir)
  547.               (or archie-download-directory "/usr/tmp")))
  548.     (if (file-directory-p to)
  549.         (setq to (concat (file-name-as-directory to) from-nondir)))
  550.     (copy-file from to 1)))
  551.  
  552. (defun archie-dired ()
  553.   "Run dired on the file or directory mentioned on the current line
  554.    of archie -l output."
  555.   (interactive)
  556.   (dired (file-name-directory (archie-get-filename))))
  557.  
  558. (defun archie-get-query-args (type-defl string-defl)
  559.   "Queries user for search type (default: TYPE-DEFL) and string
  560.  (default: STRING-DEFL).  Use to prepare args for (interactive)."
  561.   (let* ((tmp-type (or (if (or current-prefix-arg (null archie-search-type))
  562.                            (completing-read
  563.                             "Search type: "
  564.                             (archie-search-type-alist)
  565.                             nil
  566.                             t
  567.                             type-defl))
  568.                        archie-search-type))
  569.          (tmp-string (read-string
  570.                       (concat "Ask Archie for " tmp-type  " match for: ")
  571.                       string-defl)))
  572.     (if archie-search-type-sticky
  573.         (setq archie-search-type tmp-type))
  574.     (if (and current-prefix-arg (<= 16 (car current-prefix-arg)))
  575.         (let (tstr)
  576.           (setq tstr (read-from-minibuffer "Reset archie-search-hits to: "))
  577.           (while (>= 0 (string-to-int tstr))
  578.             (setq tstr
  579.                   (read-from-minibuffer
  580.                    "Must be a number greater than zero.  Reset archie-search-hits to: ")))
  581.           (setq archie-search-hits tstr)))
  582.     (list tmp-type tmp-string)))
  583.  
  584. (defun archie-modify-query (type string)
  585.   "Re-do the last archie search, with modification of the string
  586. and/or search type."
  587.   (interactive (archie-get-query-args archie-last-type archie-last-query))
  588.   (archie type string))
  589.  
  590. (defun archie-server ()
  591.   "Return current server, or prompt for new one."
  592.   (interactive)
  593.   (if archie-server
  594.       archie-server
  595.     (call-interactively 'archie-change-server)))
  596.  
  597. (defun archie-change-server (new-server)
  598.   "Change the current archie server to be NEW-SERVER."
  599.   (interactive (list
  600.                 (completing-read
  601.                  (format "Change Archie server (current: %s): " archie-server)
  602.                  archie-server-list
  603.                  nil
  604.                  t)))
  605.   (setq archie-server new-server))
  606.  
  607. (defun archie-mode ()
  608.   "Major mode for interacting with the archie program.
  609. Type: \\[archie-find-file]  to find the file on the current line,
  610. or:  \\[archie-copy] to copy it
  611. or:  \\[archie-dired] to run dired.
  612. or:  \\[convert-archie-to-dired] to convert the buffer to dired.
  613.  
  614. To redo the last search with modification of the string and/or
  615. switches, type: \\[archie-modify-query].
  616.  
  617. If archie-download-directory is set to non-nil then its value is used
  618. as the default directory while prompting for the target file by the
  619. archie-copy command; otherwise, /usr/tmp.
  620.  
  621. \\{archie-mode-map}
  622.  
  623. Runs archie-mode-hook, if defined."
  624.   (kill-all-local-variables)
  625.   (setq mode-name "Archie")
  626.   (setq major-mode 'archie-mode)
  627.   (use-local-map archie-mode-map)
  628.   (setq mode-line-process '(": %s"))
  629.   (run-hooks 'archie-mode-hook))
  630.  
  631. (run-hooks 'archie-load-hook)
  632. (provide 'archie)
  633.